home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Packages / compare.tcl next >
Encoding:
Text File  |  1997-12-10  |  3.9 KB  |  140 lines  |  [TEXT/ALFA]
  1. #========================(install)==========================================
  2. # Compare Windows.
  3. # 
  4. # Simplified (and improved) version of David C. Black's 'compare-windows'.
  5. # Modified by Mark Nagata, 2/23/93, corrected, 2/24/93.
  6. # Sped-up version, 2/25/93.
  7. #
  8. # The return position bug in David's routine (when $patt != "") 
  9. # is fixed in this version.
  10. # 
  11. # Vince renamed a couple of things and added the 'package' stuff so
  12. # this works smoothly with the new Alpha Tcl scheme.  The bindings
  13. # can now be adjusted via a preferences dialog.  Also rewrote a few
  14. # bits to try to avoid window-toggling.
  15. #===========================================================================
  16.  
  17. alpha::extension compareWindows 0.23 {
  18.     namespace eval compare {}
  19.     menu::insert Utils submenu 0 compare
  20.     menu::insert "compare" items end windowsInPlace
  21.     hook::register requireOpenWindowsHook [list compare windowsInPlace] 2
  22.     newPref binding findDifference "/`«X»" compareWindows "" compare::windowsInPlace
  23.     newPref binding findDifferenceIgnoringSpace "/1«X»" compareWindows "" compareOpt
  24.     newPref binding findNextDifference "<U/`«X»" compareWindows "" compareNext
  25.     newPref binding findNextDifferenceIgnoringSpace "<U/1«X»" compareWindows "" compareOptNext
  26.     package::addPrefsDialog compareWindows
  27. }
  28. ####
  29. # On my Extended Keyboard (where the backquote key is to the left of the 
  30. # "1" key), I bind prefix-(shift)-backquote to 'compare(Next)' and
  31. # prefix-(shift)-1 to 'compareOpt(Next)', as in the above.
  32. # 
  33. # On my Powerbook keyboard (where nothing is to the left of the "1" key),
  34. # I bind prefix-(shift)-1 to 'compare(Next)' and
  35. # prefix-(shift)-2 to 'compareOpt(Next)', respectively.
  36. ####
  37.  
  38. proc compareOpt {} {
  39.     compare::windowsInPlace {-w}
  40. }
  41.  
  42. proc compare::windowsInPlace {args} {
  43.     set    patt {}
  44.     if {$args == "-w"} {
  45.         set patt "\[ \t\n\r\]+"
  46.     }
  47.  
  48.     set    files [winNames -f]
  49.     if {[llength $files] < 2} {
  50.         alertnote "If you want to Compare texts, you need two windows."
  51.         return
  52.     }
  53.  
  54.     watchCursor
  55.     for {set i 1} {$i < 3} {incr i} {
  56.         set    wn($i) [lindex $files [expr $i -1]]
  57.         set    wp($i) [getPos -w $wn($i)]
  58.         select -w $wn($i) $wp($i) $wp($i)
  59.         set    wrt($i) [getText -w $wn($i) $wp($i) [maxPos -w $wn($i)]]
  60.         set wt($i) $wrt($i)
  61.         if {$patt != ""} {
  62.             regsub -all    $patt $wt($i) " " wt($i)
  63.         }
  64.     }
  65.         
  66.     # Exactly equal
  67.     if {$wt(1) == $wt(2)} {
  68.         alertnote    "The windows match from cursors to ends."
  69.         return
  70.     }
  71.     
  72.     # Only consider    smaller    of two strings
  73.     set    siz    [string    length $wt(1)]
  74.     if {$siz > [string length $wt(2)]} {
  75.         set    siz    [string    length $wt(2)]
  76.     }
  77.     
  78.     # Equal    except for added stuff
  79.     set    l [expr    $siz-1]
  80.     if {[string    range $wt(1) 0 $l] == [string range    $wt(2) 0 $l]} {
  81.         set    beg    $siz
  82.         set    offset(1) $beg
  83.         set    offset(2) $beg
  84.     } else {
  85.         set    beg    0
  86.         
  87.         while {$siz} {
  88.             set    siz    [expr $siz/ 2]
  89.             set    end    [expr $beg+$siz]
  90.             if {[string    range $wt(1) $beg $end]    == [string range $wt(2)    $beg $end]}    {
  91.                 incr beg $siz
  92.                 incr beg
  93.             }
  94.         }
  95.         set    offset(1) $beg
  96.         set    offset(2) $beg
  97.     }
  98.     for {set i 2} {$i > 0} {incr i -1} {
  99.         set count $offset($i)
  100.         set pos [expr $wp($i)+$count]
  101.         if {$patt != ""} {
  102.             set ans [string    range $wt($i) 0 [expr $offset($i)-1]]
  103.             set lans [string length $ans]
  104.             set tt [string range $wrt($i) 0 [expr $count-1]]
  105.             regsub -all $patt $tt " " tt
  106.             set ltt [string length $tt]
  107.             while {$ltt < $lans} {
  108.                 incr count [expr $lans-$ltt]
  109.                 incr pos [expr $lans-$ltt]
  110.                 message $pos
  111.                 set tt [string range $wrt($i) 0 [expr $count-1]]
  112.                 regsub -all $patt $tt " " tt
  113.                 set ltt [string length $tt]
  114.             }
  115.         }
  116.         
  117.         set pos [expr $pos > [maxPos -w $wn($i)] ? [maxPos -w $wn($i)] : $pos]
  118.         display -w $wn($i) [expr $pos -1]
  119.         select -w $wn($i) $pos [incr pos]
  120.         refresh $wn($i)
  121.     }
  122.     message "difference found"
  123.     return
  124. }
  125.  
  126. proc compareNext {} {
  127.     endOfLine
  128.     catch {bringToFront [lindex [winNames -f] 1]}
  129.     endOfLine
  130.     compare::windowsInPlace
  131. }
  132.  
  133. proc compareOptNext {} {
  134.     endOfLine
  135.     catch {bringToFront [lindex [winNames -f] 1]}
  136.     endOfLine
  137.     compareOpt
  138. }
  139.  
  140.